home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / AALIAS.FRM (.txt) next >
Encoding:
Visual Basic Form  |  1996-05-02  |  11.5 KB  |  379 lines
  1. VERSION 4.00
  2. Begin VB.Form AntiAliasForm 
  3.    Caption         =   "Anti-Aliasing"
  4.    ClientHeight    =   4485
  5.    ClientLeft      =   1905
  6.    ClientTop       =   1275
  7.    ClientWidth     =   5835
  8.    DrawMode        =   14  'Copy Pen
  9.    Height          =   5175
  10.    Left            =   1845
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   299
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   389
  15.    Top             =   645
  16.    Width           =   5955
  17.    Begin VB.CheckBox ColorCheck 
  18.       Caption         =   "Color"
  19.       Height          =   255
  20.       Left            =   3000
  21.       TabIndex        =   9
  22.       Top             =   45
  23.       Value           =   1  'Checked
  24.       Width           =   735
  25.    End
  26.    Begin VB.CommandButton CmdGo 
  27.       Caption         =   "Go"
  28.       Default         =   -1  'True
  29.       Height          =   375
  30.       Left            =   3960
  31.       TabIndex        =   8
  32.       Top             =   0
  33.       Width           =   615
  34.    End
  35.    Begin VB.TextBox ScaleText 
  36.       Height          =   285
  37.       Left            =   2520
  38.       TabIndex        =   6
  39.       Text            =   "2"
  40.       Top             =   30
  41.       Width           =   375
  42.    End
  43.    Begin VB.PictureBox EnlargedPic 
  44.       AutoRedraw      =   -1  'True
  45.       BackColor       =   &H00C0C0C0&
  46.       ForeColor       =   &H00000000&
  47.       Height          =   3870
  48.       Left            =   1965
  49.       Picture         =   "AALIAS.frx":0000
  50.       ScaleHeight     =   254
  51.       ScaleMode       =   3  'Pixel
  52.       ScaleWidth      =   254
  53.       TabIndex        =   4
  54.       Top             =   600
  55.       Width           =   3870
  56.    End
  57.    Begin VB.PictureBox AntiAliasedPic 
  58.       AutoRedraw      =   -1  'True
  59.       BackColor       =   &H00C0C0C0&
  60.       ForeColor       =   &H00000000&
  61.       Height          =   1935
  62.       Left            =   0
  63.       Picture         =   "AALIAS.frx":0446
  64.       ScaleHeight     =   125
  65.       ScaleMode       =   3  'Pixel
  66.       ScaleWidth      =   125
  67.       TabIndex        =   2
  68.       Top             =   2520
  69.       Width           =   1935
  70.    End
  71.    Begin VB.PictureBox AliasedPic 
  72.       AutoRedraw      =   -1  'True
  73.       BackColor       =   &H00C0C0C0&
  74.       BeginProperty Font 
  75.          name            =   "Times New Roman"
  76.          charset         =   1
  77.          weight          =   700
  78.          size            =   15.75
  79.          underline       =   0   'False
  80.          italic          =   -1  'True
  81.          strikethrough   =   0   'False
  82.       EndProperty
  83.       ForeColor       =   &H00000000&
  84.       Height          =   1935
  85.       Left            =   0
  86.       Picture         =   "AALIAS.frx":088C
  87.       ScaleHeight     =   125
  88.       ScaleMode       =   3  'Pixel
  89.       ScaleWidth      =   125
  90.       TabIndex        =   0
  91.       Top             =   240
  92.       Width           =   1935
  93.    End
  94.    Begin VB.Label Label1 
  95.       Caption         =   "Scale"
  96.       Height          =   255
  97.       Index           =   3
  98.       Left            =   2040
  99.       TabIndex        =   7
  100.       Top             =   45
  101.       Width           =   495
  102.    End
  103.    Begin VB.Label Label1 
  104.       Caption         =   "Enlarged"
  105.       Height          =   255
  106.       Index           =   2
  107.       Left            =   1965
  108.       TabIndex        =   5
  109.       Top             =   360
  110.       Width           =   735
  111.    End
  112.    Begin VB.Label Label1 
  113.       Caption         =   "Anti-Aliased"
  114.       Height          =   255
  115.       Index           =   1
  116.       Left            =   0
  117.       TabIndex        =   3
  118.       Top             =   2280
  119.       Width           =   975
  120.    End
  121.    Begin VB.Label Label1 
  122.       Caption         =   "Aliased"
  123.       Height          =   255
  124.       Index           =   0
  125.       Left            =   0
  126.       TabIndex        =   1
  127.       Top             =   0
  128.       Width           =   615
  129.    End
  130.    Begin VB.Menu mnuFile 
  131.       Caption         =   "&File"
  132.       Begin VB.Menu mnuFileExit 
  133.          Caption         =   "E&xit"
  134.       End
  135.    End
  136. Attribute VB_Name = "AntiAliasForm"
  137. Attribute VB_Creatable = False
  138. Attribute VB_Exposed = False
  139. Option Explicit
  140. ' ************************************************
  141. ' Redraw the original stuff.
  142. ' ************************************************
  143. Private Sub ColorCheck_Click()
  144.     DrawIt AliasedPic
  145. End Sub
  146. ' ************************************************
  147. ' Draw stuff in color or black and white.
  148. ' ************************************************
  149. Sub DrawIt(pic As PictureBox)
  150.     If ColorCheck.Value = vbChecked Then
  151.         ColorDrawStuff pic
  152.     Else
  153.         BWDrawStuff pic
  154.     End If
  155. End Sub
  156. ' ************************************************
  157. ' Anti-alias.
  158. ' ************************************************
  159. Sub CmdGo_Click()
  160. Dim S As Integer
  161.     MousePointer = vbHourglass
  162.     ' Redraw AliaedPic in case ColorCheck changed.
  163.     DrawIt AliasedPic
  164.     ' Make EnlargedPic the correct size.
  165.     If Not IsNumeric(ScaleText.Text) Then _
  166.         ScaleText.Text = "2"
  167.     S = CInt(ScaleText.Text)
  168.     If S < 1 Then
  169.         ScaleText.Text = "2"
  170.         S = 2
  171.     End If
  172.     EnlargedPic.Width = _
  173.         EnlargedPic.Width - _
  174.         EnlargedPic.ScaleWidth + _
  175.         S * AliasedPic.ScaleWidth
  176.     EnlargedPic.Height = _
  177.         EnlargedPic.Height - _
  178.         EnlargedPic.ScaleHeight + _
  179.         S * AliasedPic.ScaleHeight
  180.     ' Make EnlargedPic use the right thicknesses.
  181.     EnlargedPic.DrawWidth = S * AliasedPic.DrawWidth
  182.     EnlargedPic.Font.Size = S * AliasedPic.Font.Size
  183.     ' Draw the enlarged picture.
  184.     AntiAliasedPic.Cls
  185.     DrawIt EnlargedPic
  186.     DoEvents
  187.     ' Shrink the enlarged picture.
  188.     ShrinkPicture EnlargedPic, AntiAliasedPic, S
  189.     MousePointer = vbDefault
  190. End Sub
  191. ' ************************************************
  192. ' Draw some stuff in black and white.
  193. ' ************************************************
  194. Sub BWDrawStuff(pic As PictureBox)
  195. Const PI = 3.14159
  196. Const MSG = "Smile!"
  197. Dim x1 As Single
  198. Dim x2 As Single
  199. Dim x3 As Single
  200. Dim x4 As Single
  201. Dim x5 As Single
  202. Dim x6 As Single
  203. Dim x7 As Single
  204. Dim y1 As Single
  205. Dim y2 As Single
  206. Dim dy As Single
  207. Dim r1 As Single
  208. Dim r2 As Single
  209. Dim r3 As Single
  210. Dim r4 As Single
  211.     x1 = pic.ScaleWidth * 0.4
  212.     x2 = pic.ScaleWidth * 0.27
  213.     x3 = pic.ScaleWidth * 0.53
  214.     x4 = pic.ScaleWidth * 0.29
  215.     x5 = pic.ScaleWidth * 0.55
  216.     x6 = pic.ScaleWidth * 0.8
  217.     x7 = pic.ScaleWidth * 1
  218.     y1 = pic.ScaleHeight * 0.4
  219.     y2 = pic.ScaleHeight * 0.25
  220.     r1 = pic.ScaleHeight * 0.35
  221.     r2 = pic.ScaleHeight * 0.25
  222.     r3 = pic.ScaleHeight * 0.05
  223.     r4 = pic.ScaleHeight * 0.0375
  224.     pic.Cls
  225.     pic.Circle (x1, y1), r1
  226.     pic.Circle (x1, y1), r2, , PI, 2 * PI
  227.     pic.Circle (x1, y1), r3
  228.     pic.Circle (x2, y2), r3
  229.     pic.Circle (x3, y2), r3
  230.     pic.FillStyle = vbFSSolid
  231.     pic.Circle (x4, y2), r4, , , , 1.5
  232.     pic.Circle (x5, y2), r4, , , , 1.5
  233.     pic.FillStyle = vbFSTransparent
  234.     pic.CurrentX = x1 - pic.TextWidth(MSG) / 2
  235.     pic.CurrentY = (pic.ScaleHeight + y1 + r1 _
  236.         - pic.TextHeight(MSG)) / 2
  237.     pic.Print MSG
  238.     dy = pic.ScaleHeight / 15
  239.     For y1 = dy / 2 To pic.ScaleHeight Step dy
  240.         pic.Line (x6, y1)-(x7, y1 * 2)
  241.     Next y1
  242. End Sub
  243. ' ************************************************
  244. ' Draw some stuff to work with.
  245. ' ************************************************
  246. Sub ColorDrawStuff(pic As PictureBox)
  247. Const PI = 3.14159
  248. Const MSG = "Smile!"
  249. Dim x1 As Single
  250. Dim x2 As Single
  251. Dim x3 As Single
  252. Dim x4 As Single
  253. Dim x5 As Single
  254. Dim x6 As Single
  255. Dim x7 As Single
  256. Dim y1 As Single
  257. Dim y2 As Single
  258. Dim dy As Single
  259. Dim r1 As Single
  260. Dim r2 As Single
  261. Dim r3 As Single
  262. Dim r4 As Single
  263.     x1 = pic.ScaleWidth * 0.4
  264.     x2 = pic.ScaleWidth * 0.27
  265.     x3 = pic.ScaleWidth * 0.53
  266.     x4 = pic.ScaleWidth * 0.29
  267.     x5 = pic.ScaleWidth * 0.55
  268.     x6 = pic.ScaleWidth * 0.8
  269.     x7 = pic.ScaleWidth * 1
  270.     y1 = pic.ScaleHeight * 0.4
  271.     y2 = pic.ScaleHeight * 0.25
  272.     r1 = pic.ScaleHeight * 0.35
  273.     r2 = pic.ScaleHeight * 0.25
  274.     r3 = pic.ScaleHeight * 0.05
  275.     r4 = pic.ScaleHeight * 0.0375
  276.     pic.Cls
  277.     pic.FillStyle = vbFSSolid
  278.     pic.FillColor = vbYellow
  279.     pic.ForeColor = pic.FillColor
  280.     pic.Circle (x1, y1), r1
  281.     pic.FillColor = RGB(255, 153, 51)
  282.     pic.ForeColor = pic.FillColor
  283.     pic.Circle (x1, y1), r3
  284.     pic.FillColor = vbWhite
  285.     pic.ForeColor = vbBlack
  286.     pic.Circle (x2, y2), r3
  287.     pic.Circle (x3, y2), r3
  288.     pic.FillColor = vbBlack
  289.     pic.Circle (x4, y2), r4, , , , 1.5
  290.     pic.Circle (x5, y2), r4, , , , 1.5
  291.     pic.FillStyle = vbFSTransparent
  292.     pic.ForeColor = vbRed
  293.     pic.Circle (x1, y1), r2, , PI, 2 * PI
  294.     pic.ForeColor = vbBlue
  295.     pic.CurrentX = x1 - pic.TextWidth(MSG) / 2
  296.     pic.CurrentY = (pic.ScaleHeight + y1 + r1 _
  297.         - pic.TextHeight(MSG)) / 2
  298.     pic.Print MSG
  299.     pic.ForeColor = RGB(&H80, 0, &H80)
  300.     dy = pic.ScaleHeight / 15
  301.     For y1 = dy / 2 To pic.ScaleHeight Step dy
  302.         pic.Line (x6, y1)-(x7, y1 * 2)
  303.     Next y1
  304.     pic.ForeColor = vbBlack
  305. End Sub
  306. ' ************************************************
  307. ' Shrink fpic into tpic, reducing by a factor of
  308. ' 1/s.
  309. ' ************************************************
  310. Sub ShrinkPicture(fpic As PictureBox, tpic As PictureBox, S As Integer)
  311. Dim x As Integer
  312. Dim y As Integer
  313. Dim i As Integer
  314. Dim j As Integer
  315. Dim r As Long
  316. Dim g As Long
  317. Dim b As Long
  318. Dim newr As Integer
  319. Dim newg As Integer
  320. Dim newb As Integer
  321.     For y = 0 To tpic.ScaleHeight - 1
  322.         For x = 0 To tpic.ScaleWidth - 1
  323.             ' Compute the value of pixel (x, y).
  324.             r = 0
  325.             g = 0
  326.             b = 0
  327.             For i = 0 To S - 1
  328.                 For j = 0 To S - 1
  329.                     SeparateColor _
  330.                         fpic.Point(S * x + j, S * y + i), _
  331.                         newr, newg, newb
  332.                     r = r + newr
  333.                     g = g + newg
  334.                     b = b + newb
  335.                 Next j
  336.             Next i
  337.             r = r / S / S
  338.             g = g / S / S
  339.             b = b / S / S
  340.             tpic.PSet (x, y), RGB(r, g, b)
  341.         Next x
  342.         DoEvents
  343.     Next y
  344. End Sub
  345. ' ************************************************
  346. ' Break an RGB color into its components.
  347. ' ************************************************
  348. Private Sub SeparateColor(color As Long, r As Integer, g As Integer, b As Integer)
  349.     r = color Mod 256
  350.     g = color \ 256 Mod 256
  351.     b = color \ 256 \ 256
  352. End Sub
  353. Private Sub Form_Load()
  354.     ' Make everyone use the same font.
  355.     AntiAliasedPic.Font.Name = AliasedPic.Font.Name
  356.     AntiAliasedPic.Font.Bold = AliasedPic.Font.Bold
  357.     AntiAliasedPic.Font.Italic = AliasedPic.Font.Italic
  358.     AntiAliasedPic.Font.Strikethrough = AliasedPic.Font.Strikethrough
  359.     AntiAliasedPic.Font.Underline = AliasedPic.Font.Underline
  360.     EnlargedPic.Font.Name = AliasedPic.Font.Name
  361.     EnlargedPic.Font.Bold = AliasedPic.Font.Bold
  362.     EnlargedPic.Font.Italic = AliasedPic.Font.Italic
  363.     EnlargedPic.Font.Strikethrough = AliasedPic.Font.Strikethrough
  364.     EnlargedPic.Font.Underline = AliasedPic.Font.Underline
  365.         
  366.     ' Make AntiAliasedPic use the right thicknesses.
  367.     AntiAliasedPic.DrawWidth = AliasedPic.DrawWidth
  368.     AntiAliasedPic.Font.Size = AliasedPic.Font.Size
  369.         
  370.     ' Draw original stuff.
  371.     DrawIt AliasedPic
  372. End Sub
  373. Private Sub Form_Unload(Cancel As Integer)
  374.     End
  375. End Sub
  376. Private Sub mnuFileExit_Click()
  377.     Unload Me
  378. End Sub
  379.